home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / Params / ValidateXS.pm < prev   
Encoding:
Perl POD Document  |  2009-12-01  |  2.8 KB  |  161 lines
  1. package Params::Validate;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. require XSLoader;
  7. XSLoader::load( 'Params::Validate', $Params::Validate::VERSION );
  8.  
  9.  
  10. my $default_fail = sub { require Carp;
  11.                          Carp::confess($_[0]) };
  12.  
  13. {
  14.     my %defaults = ( ignore_case   => 0,
  15.              strip_leading => 0,
  16.              allow_extra   => 0,
  17.              on_fail       => $default_fail,
  18.              stack_skip    => 1,
  19.                      normalize_keys => undef,
  20.            );
  21.  
  22.     *set_options = \&validation_options;
  23.     sub validation_options
  24.     {
  25.     my %opts = @_;
  26.  
  27.     my $caller = caller;
  28.  
  29.     foreach ( keys %defaults )
  30.     {
  31.         $opts{$_} = $defaults{$_} unless exists $opts{$_};
  32.     }
  33.  
  34.     $OPTIONS{$caller} = \%opts;
  35.     }
  36. }
  37.  
  38. sub _check_regex_from_xs { return ( defined $_[0] ? $_[0] : '' ) =~ /$_[1]/ ? 1 : 0 }
  39.  
  40. BEGIN
  41. {
  42.     if ( $] >= 5.006 && $] < 5.007 )
  43.     {
  44.         eval <<'EOF';
  45. sub check_for_error
  46. {
  47.     if ( defined $Params::Validate::ERROR )
  48.     {
  49.         $Params::Validate::ON_FAIL ||= sub { require Carp; Carp::croak( $_[0] ) };
  50.  
  51.         $Params::Validate::ON_FAIL->($Params::Validate::ERROR)
  52.     }
  53. }
  54.  
  55. sub validate_pos (\@@)
  56. {
  57.     local $Params::Validate::ERROR;
  58.     local $Params::Validate::ON_FAIL;
  59.     local $Params::Validate::CALLER = caller;
  60.  
  61.     my $r;
  62.     if (defined wantarray)
  63.     {
  64.         $r = &_validate_pos;
  65.     }
  66.     else
  67.     {
  68.         &_validate_pos;
  69.     }
  70.  
  71.     check_for_error();
  72.  
  73.     return wantarray ? @$r : $r if defined wantarray;
  74. }
  75.  
  76. sub validate (\@$)
  77. {
  78.     local $Params::Validate::ERROR;
  79.     local $Params::Validate::ON_FAIL;
  80.     local $Params::Validate::CALLER = caller;
  81.  
  82.     my $r;
  83.     if (defined wantarray)
  84.     {
  85.         $r = &_validate;
  86.     }
  87.     else
  88.     {
  89.         &_validate;
  90.     }
  91.  
  92.     check_for_error();
  93.  
  94.     return wantarray ? %$r : $r if defined wantarray;
  95. }
  96.  
  97. sub validate_with
  98. {
  99.     local $Params::Validate::ERROR;
  100.     local $Params::Validate::ON_FAIL;
  101.     local $Params::Validate::CALLER = caller;
  102.  
  103.     my $r;
  104.     if (defined wantarray)
  105.     {
  106.         $r = &_validate_with;
  107.     }
  108.     else
  109.     {
  110.         &_validate_with;
  111.     }
  112.  
  113.     check_for_error();
  114.  
  115.     my %p = @_;
  116.     if ( UNIVERSAL::isa( $p{spec}, 'ARRAY' ) )
  117.     {
  118.         return wantarray ? @$r : $r if defined wantarray;
  119.     }
  120.     else
  121.     {
  122.         return wantarray ? %$r : $r if defined wantarray;
  123.     }
  124. }
  125. EOF
  126.  
  127.         die $@ if $@;
  128.     }
  129.     else
  130.     {
  131.         *validate      = \&_validate;
  132.         *validate_pos  = \&_validate_pos;
  133.         *validate_with = \&_validate_with;
  134.     }
  135. }
  136.  
  137. 1;
  138.  
  139. __END__
  140.  
  141. =head1 NAME
  142.  
  143. Params::ValidateXS - XS implementation of Params::Validate
  144.  
  145. =head1 SYNOPSIS
  146.  
  147.   See Params::Validate
  148.  
  149. =head1 DESCRIPTION
  150.  
  151. This is an XS implementation of Params::Validate.  See the
  152. Params::Validate documentation for details.
  153.  
  154. =head1 COPYRIGHT
  155.  
  156. Copyright (c) 2004-2007 David Rolsky.  All rights reserved.  This
  157. program is free software; you can redistribute it and/or modify it
  158. under the same terms as Perl itself.
  159.  
  160. =cut
  161.